home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / tpw2vb / tpw_push.pas < prev    next >
Pascal/Delphi Source File  |  1992-09-25  |  8KB  |  260 lines
  1. library tpw_push;
  2.  
  3. {$R tpw_push.RES}
  4. {$D Opaque Software ⌐ - TPW Push Demo}
  5.  
  6.  
  7. uses wintypes, winprocs, tpw2vb_d, { <--- This is a demo version of TPW2VB}
  8.          strings;
  9.  
  10.  
  11. {//---------------------------------------------------------------------------
  12. // Resource ID's
  13. //---------------------------------------------------------------------------
  14. // Toolbox bitmap resource IDs.
  15. //---------------------------------------------------------------------------}
  16. const
  17.     IDBMP_Push        =    8000;
  18.     IDBMP_PushDOWN    =    8001;
  19.     IDBMP_PushMONO    =    8003;
  20.     IDBMP_PushEGA          =    8006;
  21.  
  22. {//---------------------------------------------------------------------------
  23. // Standard Error Values
  24. //---------------------------------------------------------------------------}
  25.     ERR_None          =    0;
  26.     ERR_InvPropVal        =    380;     {/ Error$(380) = "Invalid property value"}
  27.  
  28.  
  29. {//---------------------------------------------------------------------------
  30. // Procedure Declarations
  31. //---------------------------------------------------------------------------}
  32.  
  33. {//---------------------------------------------------------------------------
  34. // Global Variables and Constants
  35. //---------------------------------------------------------------------------}
  36.  
  37. {//---------------------------------------------------------------------------
  38. // Push control data and structs
  39. //---------------------------------------------------------------------------}
  40. type
  41.     PPush = ^TPush;
  42.     TPush = record
  43.         AutoBeep:     Bool;
  44.     end;
  45.  
  46. {//---------------------------------------------------------------------------
  47. // Property list
  48. //---------------------------------------------------------------------------
  49. // Define the consecutive indicies for the properties
  50. //---------------------------------------------------------------------------}
  51. const
  52.     IPROP_Push_NAME       =    $0000;
  53.     IPROP_Push_INDEX      = $0001;
  54.     IPROP_Push_PARENT      = $0002;
  55.     IPROP_Push_BACKCOLOR  = $0003;
  56.     IPROP_Push_LEFT       = $0004;
  57.     IPROP_Push_TOP          = $0005;
  58.     IPROP_Push_WIDTH      = $0006;
  59.     IPROP_Push_HEIGHT      = $0007;
  60.     IPROP_Push_ENABLED      = $0008;
  61.     IPROP_Push_VISIBLE      = $0009;
  62.     IPROP_Push_MOUSEPOINTER   = $000A;
  63.     IPROP_Push_CAPTION      = $000B;
  64.     IPROP_Push_FONTNAME      = $000C;
  65.     IPROP_Push_FONTSIZE      = $000D;
  66.     IPROP_Push_FONTBOLD      = $000E;
  67.     IPROP_Push_FONTITALIC      = $000F;
  68.     IPROP_Push_FONTSTRIKE      = $0010;
  69.     IPROP_Push_FONTUNDER      = $0011;
  70.     IPROP_Push_DRAG       = $0012;
  71.     IPROP_Push_DRAGICON      = $0013;
  72.     IPROP_Push_TABINDEX      = $0014;
  73.     IPROP_Push_TABSTOP      = $0015;
  74.     IPROP_Push_TAG          = $0016;
  75.     IPROP_Push_AutoBeep      = $0017;
  76.  
  77. Property_AutoBeep: PROPINFO  =
  78. (
  79.     npszName:     NPnt(PChar('AutoBeep'));
  80.     fl:              DT_Bool or PF_fGetData or PF_fSetData or PF_fSaveData;
  81.     offsetData: 0;
  82.     infoData:    0;        
  83.     dataDefault:     0;
  84.     npszEnumList:     0;
  85.     enumMax:    0        
  86. );
  87.  
  88. const
  89.     PropListPush : array[0..24]of PPROPINFO =
  90. (
  91.     PPROPINFO_STD_CTLNAME,
  92.     PPROPINFO_STD_INDEX,
  93.     PPROPINFO_STD_PARENT,
  94.     PPROPINFO_STD_BACKCOLOR,
  95.     PPROPINFO_STD_LEFT,
  96.     PPROPINFO_STD_TOP,
  97.     PPROPINFO_STD_WIDTH,
  98.     PPROPINFO_STD_HEIGHT,
  99.     PPROPINFO_STD_ENABLED,
  100.     PPROPINFO_STD_VISIBLE,
  101.     PPROPINFO_STD_MOUSEPOINTER,
  102.     PPROPINFO_STD_CAPTION,
  103.     PPROPINFO_STD_FONTNAME,
  104.     PPROPINFO_STD_FONTSIZE,
  105.     PPROPINFO_STD_FONTBOLD,
  106.     PPROPINFO_STD_FONTITALIC,
  107.     PPROPINFO_STD_FONTSTRIKE,
  108.     PPROPINFO_STD_FONTUNDER,
  109.     PPROPINFO_STD_DRAGMODE,
  110.     PPROPINFO_STD_DRAGICON,
  111.     PPROPINFO_STD_TABINDEX,
  112.     PPROPINFO_STD_TABSTOP,
  113.     PPROPINFO_STD_TAG,
  114.     PPropInfo(@Property_AutoBeep),
  115.     0
  116. );
  117.  
  118. {//---------------------------------------------------------------------------
  119. // Event Procedure Parameter Profiles
  120. //---------------------------------------------------------------------------}
  121. type
  122.     TParams = record
  123.         ClickString:     HLStr;
  124.         Index:            Pointer;    {// Reserve space for index parameter to array ctl}
  125.     end;
  126.  
  127. {//---------------------------------------------------------------------------
  128. // Event list
  129. //---------------------------------------------------------------------------
  130. // Define the consecutive indicies for the events
  131. //---------------------------------------------------------------------------}
  132. const
  133.     EVENT_PUSH_CLICK    =    0;
  134.     EVENT_PUSH_DRAGDROP    =    1;
  135.     EVENT_PUSH_DRAGOVER    =    2;
  136.     EVENT_PUSH_GOTFOCUS    =    3;
  137.     EVENT_PUSH_KEYDOWN    =    4;
  138.     EVENT_PUSH_KEYPRESS    =    5;
  139.     EVENT_PUSH_KEYUP    =    6;
  140.     EVENT_PUSH_LOSTFOCUS    =    7;
  141.  
  142. {//---------------------------------------------------------------------------
  143. // Event procedure parameter prototypes
  144. //---------------------------------------------------------------------------}
  145.     Parms_SD:    array[0..0]of word = (ET_SD);            {// 1 x SD parm}
  146.  
  147. Event_Click: EVENTINFO  = (
  148.     npszName:         NPnt(PChar('Click'));
  149.     cParms:            1;
  150.     cwParms:         2;    
  151.     npParmTypes:    NPnt(@Parms_SD);
  152.     npszParmProf:    NPnt(PChar('ButtonCaption as String'));
  153.     fl:                0
  154. );
  155.  
  156. EventListPush: array[0..8]of PEVENTINFO = (
  157.     PEventInfo(@Event_Click),
  158.     PEVENTINFO_STD_DRAGDROP,
  159.     PEVENTINFO_STD_DRAGOVER,
  160.     PEVENTINFO_STD_GOTFOCUS,
  161.     PEVENTINFO_STD_KEYDOWN,
  162.     PEVENTINFO_STD_KEYPRESS,
  163.     PEVENTINFO_STD_KEYUP,
  164.     PEVENTINFO_STD_LOSTFOCUS,
  165.     0
  166. );
  167.  
  168. {//---------------------------------------------------------------------------
  169. //     Control Procedure
  170. //    This routine is called for all VB and Windows Msgs.
  171. //---------------------------------------------------------------------------}
  172. function PushCtlProc(Control: HCtl; Wnd: HWnd;
  173.             Msg, WParam: Word; LParam: LongInt):LongInt; export;
  174. var
  175.     Params:        TParams;
  176.     StrBuf:        array[0..19]of char;
  177.     Caption:    Integer;
  178.     error:        Err;
  179.     tmpStr:        PChar;
  180.     Push:        PPush;
  181. begin
  182.     Push := PPush(VBDerefControl(Control));
  183.  
  184.     case Msg of
  185.         VBM_MNEMONIC,
  186.         VBN_COMMAND: begin
  187.             if Msg = VBM_MNEMONIC then
  188.                 {// Act like a click}
  189.                 LParam := MAKELONG(0,BN_CLICKED);
  190.             case HIWORD(LParam) of
  191.                 BN_CLICKED: begin
  192.                     Caption := GetWindowText(Wnd, StrBuf, 20);
  193.                     Params.ClickString := VBCreateHlstr(@StrBuf, Caption);
  194.                     if Push^.AutoBeep then
  195.                         Messagebeep(0);
  196.                     error := VBFireEvent(Control, EVENT_Push_Click, @Params);
  197.                     VBDestroyHlstr(Params.ClickString);
  198.                     end;
  199.             end;
  200.             PushCtlProc := 0;
  201.             exit;
  202.             end;
  203.  
  204.         VBM_SETPROPERTY:
  205.             case WParam of
  206.                 IPROP_PUSH_CAPTION: 
  207.                     {// To avoid a Windows problem, make sure text is
  208.                     // under 255 bytes:}
  209.                     if (lstrlen(PChar(LParam)) > 255) then
  210.                         PChar(LParam)[255] := #0;
  211.             end;
  212.             
  213.     end;
  214.  
  215.     {// Default processing:}
  216.     PushCtlProc := VBDefControlProc(Control, Wnd, Msg, WParam, LParam);
  217.  
  218. end;
  219.  
  220. {//---------------------------------------------------------------------------
  221. // Model struct
  222. //---------------------------------------------------------------------------
  223. // Define the control model (using the event and property structures).
  224. //---------------------------------------------------------------------------}
  225. const
  226. modelPush: TMODEL = (
  227.     usVersion:        VB_VERSION;                            { VB version used by control}
  228.     fl:                MODEL_fFocusOk or MODEL_fMnemonic;     { Bitfield structure}
  229.     ctlproc:        TFarProc(@PushCtlProc);                { The control proc.}
  230.     fsClassStyle:    cs_VRedraw or cs_HRedraw;            { window class style}
  231.     flWndStyle:        BS_PUSHBUTTON;                         { default window style}
  232.     cbCtlExtra:        sizeof(TPush);                        { # bytes alloc'd for HCTL structure}
  233.     idBmpPalette:    IDBMP_Push;                            { BITMAP id for tool palette}
  234.     DefCtlName:     NPnt(PChar('TpwPush'));                 { default control name prefix}
  235.     ClassName:        NPnt(PChar('TpwPushButton'));            { Visual Basic class name}
  236.     ParentClassName:    NPnt(PChar('Button'));            { Parent window class if subclassed}
  237.     proplist:        ofs(PropListPush)    ;                { Property list}
  238.     eventlist:        ofs(EventListPush);                 { Event list}
  239.     nDefProp:         0;                                    { index of default property}
  240.     nDefEvent:        0                                    { index of default event}
  241. );
  242.  
  243. {//---------------------------------------------------------------------------
  244. // Register custom control.
  245. //    This routine is called by VB when the custom control DLL is
  246. //    loaded for use.
  247. //---------------------------------------------------------------------------}
  248. function VBINITCC(usVersion: Word; fRunTime: Boolean): Boolean; export;
  249. begin
  250.     VBINITCC := VBRegisterModel(HInstance, modelPush);
  251. end;
  252.  
  253. exports
  254.     VBINITCC index 2,
  255.     PushCtlProc index 3;
  256.  
  257. begin
  258.  
  259. end.
  260.